home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb38.arc / KENO.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-20  |  4KB  |  174 lines
  1.  program keno (input,output);
  2.  
  3. const
  4.    payoff5          = 10;    (* for 5 spots player gets $10      *)
  5.    payoff6          = 100;   (* for 6 spots player gets $100     *)
  6.    payoff7          = 2200;  (* for 7 spots player gets $2200    *)
  7.    payoff8          = 25000; (* for 8 spots player gets $25000   *)
  8.    totalspots       = 80;    (* total of 80 possible spots       *)
  9.    numcompspots     = 20;    (* computer picks 20 spots          *)
  10.    numplayerspots   = 8;     (* player gets 8 spots              *)
  11.    cost             = 1.20;  (*cost to play a game               *)
  12.  
  13. type
  14.    spottype = set of 1..totalspots;
  15.  
  16. var
  17.    compspots   : spottype; (* spots the computer chooses *)
  18.    playerspots : spottype; (* player's spots *)
  19.    money       : real;     (* player has this much money *)
  20.    ch          : char;     (* input char to see if user wishes to conyinue *)
  21.  
  22. (*
  23.  * getspots
  24.  * get the player's 8 spots from him
  25.  *)
  26.  
  27. procedure getspots;
  28. var
  29.    i : 0..numplayerspots; (* number of spots player has chosen so far *)
  30.    spot : integer;        (* number just chosen *)
  31. begin
  32.    i := 0;
  33.    playerspots := [];
  34.    while i < numplayerspots do
  35.    begin
  36.       randomize;
  37.       writeln ('Your spot? ');
  38.       readln (spot);
  39.       if (spot < 1) or (spot > totalspots) then
  40.          writeln ('illegal spot number.')
  41.       else
  42.          if spot in playerspots then
  43.             writeln ('You have already chosen spot ',spot)
  44.          else
  45.             begin
  46.                i := i+1;
  47.                playerspots := playerspots + [spot]
  48.             end
  49.    end
  50. end;
  51.  
  52.  
  53. (*
  54.  * computer
  55.  * have the computer pick its spots
  56.  *)
  57.  
  58. procedure computer;
  59. var
  60.    i : 0..numcompspots;   (* number of spots chosen so far *)
  61.    spot : 0..totalspots;
  62.  
  63. begin
  64.    i := 0;
  65.    compspots := [];
  66.    writeln ('The computer chooses ');
  67.    while i < numcompspots do
  68.    begin
  69.       spot := 1 + (random(totalspots));
  70.       if not (spot in compspots) then
  71.       begin
  72.          compspots := compspots + [spot];
  73.          i := i+1;
  74.       end;
  75.    end;
  76.  
  77.  
  78. (*
  79.  * print out the computer's spots in
  80.  * order by going linearly through
  81.  * all numbers
  82.  *)
  83.    i := 0;
  84.    spot := 0;
  85.    while i <numcompspots do
  86.    begin
  87.       spot := spot +1;
  88.       if spot in compspots then
  89.       begin
  90.          write(spot:3);
  91.          i := i+1;
  92.          if i=10 then
  93.             writeln
  94.       end;
  95.    end;
  96.    writeln
  97. end;
  98.  
  99. (*
  100.  * score
  101.  * find out how much (if anything) the
  102.  * player has won
  103.  *)
  104.  
  105.  
  106. procedure score;
  107. var
  108.    i : 0..numplayerspots;      (* number of matches made *)
  109.    spot : 1..totalspots;       (* current spot number *)
  110. begin
  111.    money := money - cost;       (* charge for the card *)
  112.    i := 0;
  113.    for spot := 1 to totalspots do
  114.       if (spot in compspots) and (spot in playerspots) then
  115.          i :=+ i+1;
  116.    if i in [5,6,7,8] then
  117.    begin
  118.       write('You lucky person, you have ',i);
  119.       writeln(' matches');
  120.       write('That means you have made ');
  121.       case i of
  122.          5:
  123.             begin
  124.                writeln(payoff5);
  125.                money := money + payoff5
  126.             end;
  127.          6:
  128.             begin
  129.                writeln(payoff6);
  130.                money := money + payoff6
  131.             end;
  132.          7:
  133.             begin
  134.                writeln(payoff7);
  135.                money := money + payoff7
  136.             end;
  137.          8:
  138.             begin
  139.                writeln(payoff8);
  140.                money := money + payoff8
  141.             end;
  142.       end
  143.    end
  144.    else
  145.       writeln('Sorry, but you only matched ',i);
  146.  
  147.    writeln;
  148.    if money >= 0 then
  149.       writeln('Your total money is $',money:4:2)
  150.    else
  151.       writeln('So far you have lost $',abs(money):4:2);
  152.    writeln
  153. end;
  154.  
  155.  
  156. begin
  157.    money := 0;
  158.    while (ch <> 'n') and (ch <> 'N') do
  159.    begin
  160.       getspots;
  161.       computer;
  162.       score;
  163.       writeln;
  164.       write('Want to play Keno again? ');
  165.       readln(ch)
  166.    end;
  167.    writeln;
  168.    writeln('All right then leave, see if i care!!!');
  169.    if (money >= 0) then
  170.       writeln('You made $',money:5:2)
  171.    else
  172.       writeln('you lost $',abs(money):5:2)
  173. end.
  174.